home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0026_Finding Anagrams.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  6KB  |  215 lines
  1. {$A+,B+,D+,E-,F+,G+,I+,L+,N-,O+,P+,Q+,R+,S+,T+,V-,X+,Y+}
  2. {$M 65520,100000,655360}
  3. {
  4. Program compiled and tested With BP 7.0
  5.  
  6. WARNING since this Program is not using the fastest algorithm to
  7. find it's Anagrams, long Delays can be expected For large
  8. input-Strings.
  9.  
  10. Test have shown the following results:
  11.  
  12.   Length of Input       Number of anagrams found
  13.  
  14.         2                         2
  15.         3                         6
  16.         4                        24
  17.         5                       120
  18.         6                       720
  19.         7                      5040
  20.  
  21. As can plainly be seen from this, the number of Anagrams For a
  22. String of length N is a direct Function of the number of Anagrams
  23. For a String of N-1. In fact the result is f(N) = N * f(N-1).
  24.  
  25. You might have recognised the infamous FACTORIAL Function!!!
  26.  
  27. Type
  28.   MyType = LongInt;
  29.  
  30. Function NumberOfAnagrams(Var InputLen : MyType) : MyType;
  31.  
  32.   Var
  33.     Temp : MyType;
  34.  
  35.   begin
  36.     Temp := InputLen;
  37.     if Temp >1 then
  38.     begin
  39.       Temp := Temp - 1;
  40.       NumberOfAnagrams := InputLen * NumberOfAnagrams(Temp);
  41.     end else
  42.       NumberOfAnagrams := InputLen;
  43.   end;
  44.  
  45. The above Function has been tested and found to work up to an input
  46. length of 12. After that, Real numbers must be used. As a side note
  47. the Maximum value computable was 1754 With MyType defined as
  48. Extended and Numeric-Coprocessor enabled of course. Oh and BTW, the
  49. parameter is passed as a Var so that the Stack doesn't blow up when
  50. you use Extended Type!!!! As a result, you can't pass N-1 to the
  51. Function. You have to STORE N-1 in a Var and pass that as parameter.
  52. The net effect is that With Numeric Copro enabled, at 1754 it blows
  53. up because of a MATH OVERFLOW, not a STACK OVERFLOW!!!
  54.  
  55. Based on these findings, I assume the possible anagrams can be
  56. computed a lot faster simply by Realising that the possible Anagrams
  57. For an input length of (N) can be found by finding all anagrams for
  58. an input Length of (N-1) and inserting the additional letter in each
  59. (N) positions in those Strings. Since this can not be done
  60. recursively in memory, the obvious solution would be to to output
  61. the anagrams strating With the first 4 or 5 caracters to a File,
  62. because those can be found quickly enough, and then to read in each
  63. String and apply the following caracters to each and Repeat this
  64. process Until the final File is produced.
  65.  
  66. Here is an example:
  67.  
  68.       Anagrams For ABCD
  69.  
  70.       Output Anagrams For AB to File
  71.  
  72.         Giving      AB and BA
  73.  
  74.       read that in and apply the next letter in all possible positions
  75.  
  76.         Giving
  77.                   abC
  78.                   aCb
  79.                   Cab
  80.                 &
  81.                   baC
  82.                   bCa
  83.                   Cba
  84.  
  85.       Now Apply the D to this and get
  86.  
  87.                   abcD
  88.                   abDc
  89.                   aDbc
  90.                   Dabc
  91.                 &
  92.  
  93.                   acbD
  94.                   acDb
  95.                   aDcb
  96.                   Dacb
  97.  
  98.       Etc... YOU GET THE POINT!!!
  99.  
  100. BTW Expect LARGE Files if you become too enthousiastic With this!!!
  101.  
  102.   An Input of just 20 caracters long will generate a File of
  103.  
  104.         2,432,902,008,176,640,000 Anagrams
  105.         That's
  106.           2.4 Quintillion Anagrams
  107.  
  108.   Remember that each of those are 20 caracters long,
  109.   add Carriage-return and line-feeds and you've got yourself a
  110.   HUGE File ;-)
  111.  
  112.   In fact just a 10 Caracter input length will generate 3.6 Million
  113.   Anagrams from a 10 Caracter input-String. Again add Cr-LFs and
  114.   you've got yourself a 43.5 MEGAByte File!!!!!! but consider you
  115.   are generating it from the previous File which comes to 3.5 MEG
  116.   For an Input Length of 9 and you've got yourself 45 MEG of DISK in
  117.   use For this job.
  118.  
  119. }
  120. Uses
  121.   Strings, Crt;
  122.  
  123. Const
  124.   MaxAnagram = 1000;
  125.  
  126. Type
  127.   AnagramArray = Array[0..MaxAnagram] of Word;
  128.   AnagramStr   = Array[0..MaxAnagram] of Char;
  129.  
  130. Var
  131.   Target       : AnagramStr;
  132.   Size         : Word;
  133.   Specimen     : AnagramArray;
  134.   Index        : Word;
  135.   AnagramCount : LongInt;
  136.  
  137. Procedure working;
  138. Const
  139.   CurrentCursor : Byte = 0;
  140.   CursorArray   : Array[0..3] of Char = '|/-\';
  141. begin
  142.   CurrentCursor := Succ(CurrentCursor) mod 4;
  143.   Write(CursorArray[CurrentCursor], #13);
  144. end;
  145.  
  146. Procedure OutPutAnagram(Target : AnagramStr;
  147.                         Var Specimen : AnagramArray; Size : Word);
  148. Var
  149.   Index : Word;
  150. begin
  151.   For Index := 0 to (Size - 1) do
  152.     Write(Target[Specimen[Index]]);
  153.   Writeln;
  154. end;
  155.  
  156. Function IsAnagram(Var Specimen : AnagramArray; Size : Word) : Boolean;
  157. Var
  158.   Index1,
  159.   Index2 : Word;
  160.   Valid  : Boolean;
  161. begin
  162.   Valid  := True;
  163.   Index1 := 0;
  164.   While (Index1<Pred(Size)) and Valid do
  165.   begin
  166.     Index2 := Index1 + 1;
  167.     While (Index2 < Size) and Valid do
  168.     begin
  169.       if Specimen[Index1] = Specimen[Index2] then
  170.         Valid := False;
  171.       inc(Index2);
  172.     end;
  173.     inc(Index1);
  174.   end;
  175.   IsAnagram := Valid;
  176. end;
  177.  
  178. Procedure FindAnagrams(Target : AnagramStr;
  179.                        Var Specimen : AnagramArray; Size : Word);
  180. Var
  181.   Index : Word;
  182.   Carry : Boolean;
  183. begin
  184.   Repeat
  185.     working;
  186.     if IsAnagram(Specimen, Size) then
  187.     begin
  188.       OutputAnagram(Target, Specimen, Size);
  189.       inc(AnagramCount);
  190.     end;
  191.     Index := 0;
  192.     Repeat
  193.       Specimen[Index] := (Specimen[Index] + 1) mod Size;
  194.       Carry := not Boolean(Specimen[Index]);
  195.       Inc(Index);
  196.     Until (not Carry) or (Index >= Size);
  197.   Until Carry and (Index >= Size);
  198. end;
  199.  
  200. begin
  201.   ClrScr;
  202.   Write('Enter anagram Target: ');
  203.   readln(Target);
  204.   Writeln;
  205.   AnagramCount := 0;
  206.   Size := Strlen(Target);
  207.   For Index := 0 to MaxAnagram do
  208.     Specimen[Index] := 0;
  209.   For Index := 0 to Size - 1 do
  210.     Specimen[Index] := Size - Index - 1;
  211.   FindAnagrams(Target, Specimen, Size);
  212.   Writeln;
  213.   Writeln(AnagramCount, ' Anagrams found With Source ', Target);
  214. end.
  215.